perm filename PT2.OLD[MSS,LCS]1 blob sn#179207 filedate 1975-09-26 generic text, type T, neo UTF8
00010		DATA QLINE/150.0/,HX/2./,ZL/2./,ZM/-1.5/
00015	C  QLINE=BASIC LINE LENGTH, HX=HEIGHT MULTIPLIER, ZL=LN. LNGTH FACTOR.
00020	
00030		COMMON/XRN/RN(2000) /SF/KL,RT,KP,STFSZ,NAMX
00040		COMMON RS,JA,CLEFQ,AA,RQ(16),KQ,NQ,JQ,JJQ,KBQ,NAQ
00050		COMMON/STF/RSTFAC(-3/4),RSTJ2
00060		COMMON/POSI/STFF(-3/4),SIGQ,PQ/PTR/PWDS(250),L,LL,I,RXQ
00070		DIMENSION IV(78)
00080		EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5))
00090		1,(R8,RQ(6)),(R9,RQ(7)),(IV,PWDS)
00100		COMMON /PX/SX,PN(1800),Q(6000)
00200		CALL IFILE(1,'PX')
00220		READ(1),L,LL,
00240		1(PN(N),N=1,L+1),(Q(N),N=1,LL-1),NAMX,STFSZ,J,J,RSTFAC,STFF,IV,STFF
00300		RSTJ2=STFSZ
00310	2000	I=L
00410		KK=1
00420		XLINE=QLINE
00430		ENDLN=Q(IFIX(PN(L))+3)
00760		TYPE 4,J
00770	4	FORMAT(I4,' LINES - OR TYPE NUM --',$)
00780		ACCEPT 5,RA
00790	5	FORMAT(F)
00792		IF(RA.NE.0)XLINE=ENDLN/(RA+ZL)
00793		ZLINE=XLINE
00795		RA=0
00800		CLEF=-99
00850		JSLUR=0
00900		SIG=CLEF
01100	100	KL=1
01300		KP=1
01600		RT=2
01800		J=KK
01900		HGT=HX*2.
01950	
02000		DO 1 K=KK,I
02100		N=PN(K)
02200		IF(Q(N+1).NE.4)GO TO 1
02300	CC	IF(Q(N).GT.2)GO TO 1
02400		IF(Q(N+3).LT.XLINE)GO TO 1
02500	C  FOUND LAST BAR LINE.
02510		RX=0
02600	3	JJ=KP
02700	C PUTS IN STAFF
02705		RS=3.
02710		IF(RT.NE.0)GO TO 331
02720	C NEXT FOR BOTTOM STAFF.  PUTS IN SPACER.
02730		RS=6.
02740		R8=2.45
02800	331	CALL STAFF(RS,8.,0,HGT,STFSZ,0,0,R8)
02820		HGT=HGT-HX
02900		IF(XLINE.EQ.ZLINE)GO TO 33
02910		IF(XLINE.LT.ENDLN)GO TO 6
02914		RX=RT
02916		RT=0
02918		CALL STAFF(6.,8.,0,0,0,0,1.,2.45)
02922	C  PUTS IN SPACER
02925		RT=RX
02928	6	IF(JSLUR.EQ.0)GO TO 333
02930		CALL STAFF(5.,5.,0,Q(JSLUR),Q(JSLUR+1),11.,Q(JSLUR+3),0)
02940		JSLUR=0
03000	333	IF(CLEF.EQ.-99)GO TO 33
03100	C  ONLY STAFF FOR FIRST LINE AT TOP.
03200		RX=10.*STFSZ
03300	C  THE SPACER
03500		CALL STAFF(3.,3.,1.,0,CLEF,0,0,0)
03600		IF(SIG.EQ.-99)GO TO 33
03710		RS=3.
03720		R5=SIG
03730		RX=0
03740		IF(R5.LT.50)GO TO 332
03750		RX=IFIX((R5+50.)/100.)
03760		R5=R5-RX*100.
03770		RS=4.
03800	C  CLEF+SIG
04000	332	CALL STAFF(RS,17.,11.0*STFSZ,0,R5,RX,0,0)
04010		RX=13.*STFSZ
04100	
04200	33	R4=RA
04300		R5=Q(N+3)
04400		RS=3
04500		R7=RT
04600		R8=RX
04700		R9=200.
04800		LL=0
04900		L=K-J+1
05000		CALL PTMOVE(Q,PN(J))
05100		RA=R5
05200		KB=KL
05300		DO 30 NA=KK,K
05400		PWDS(KP)=KB
05500		KP=KP+1
05510		JK=PN(NA)
05520		R=Q(JK+1)
05530		IF(R.NE.5)GO TO 35
05540		IF(Q(JK+6).LT.199.)GO TO 30
05542	C CATCHES END OF SLUR
05545		Q(JK+6)=201.
05547		JSLUR=JK+4
05548	C  TO PUT SLUR ON NEXT LINE.
05560		GO TO 30
05570	35	IF(R.NE.2)GO TO 36
05580		IF(Q(JK).LT.6.)GO TO 30
05590	CC	RR=Q(IFIX(PN(NA-1))+3)
05592		RR=RIGHT(NA,-1)
05595		IF(RR.GE.199.)RR=RX
05600	CC	Q(JK+3)=RR-1.6*STFSZ+(Q(IFIX(PN(NA+1))+3)-RR)/2.
05602		Q(JK+3)=RR-1.6*STFSZ+(RIGHT(NA,1)-RR)/2.
05603	C  FUNCTION 'RIGHT' FINDS RIGHT ITEMS FOR CENTERING.
05605	C CENTERS WHOLE REST
05607		GO TO 30
05610	36	IF(R.NE.3)GO TO 34
05619		RR=Q(JK+5)
05628		IF(Q(JK).LT.3)RR=0
05637		CLEF=RR
05646		GO TO 30
05655	34	IF(R.NE.17)GO TO 37
05664		SIG=Q(JK+5)
05673		IF(Q(JK).GT.3)SIG=SIG+Q(JK+6)*100.
05682	C  CLEF # IN P6 WITH KEY SIGS.
05710	C  NEXT CHANGES CODE NUM BACK TO ORIGINAL
05730	37	IF(R.GE.33)Q(JK+1)=R/11.
05810	30	KB=PN(NA+1)-PN(NA)+KB
05820	
05830		DO 31 NA=IFIX(PN(KK)),IFIX(PN(K+1)-1.)
05900		RN(KL)=Q(NA)
06000	31	KL=KL+1
06050		KK=K+1
06100		RS=RT
06200		LL='J'
06300		R4=0
06400		R5=200
06500		NA=L
06600		L=KP-JJ+1
06700		CALL PTMOVE(RN,PWDS(JJ))
06710		IF(K.EQ.I)GO TO 2
06800		L=NA
06900		J=K+1
07000	C  SO IT DOESN'T GO THRU ALL DATA
07100		RT=RT-1
07200		XLINE=RA+ZLINE
07250		IF(ENDLN-XLINE.LT.80.)XLINE=ENDLN
07310	10	IF(KL.GT.1700.OR.KP.GT.190.OR.RT)GO TO 2
07400	1	IF(K.EQ.I)GO TO 3
07600	2	L=KP
07610		PWDS(KP+1)=KB
07670		J=1
07718		CALL OFILE(1,NAMX)
07766		LL=PWDS(L+1)
07770	2929	WRITE(1),L,LL,
07780		1(PWDS(N),N=1,L+1),(RN(N),N=1,LL-1),J,J,J,J,RSTFAC,STFF,IV,STFF
07785		TYPE 101,NAMX
07787	101	FORMAT(1XA5)
07790		IF(KK.GE.I)CALL EXIT
07800		NAMX=NAMX+2
07810		END FILE(1)
07820		GO TO 100
07910		END
07920	
07930		SUBROUTINE STAFF(P0,P1, P3,P4,P5,P6,P7,P8)
08000		COMMON/XRN/RN(2000) /SF/KL,RT,KP,STFSZ,NAMX
08100		COMMON /PTR/PWDS(250),L,LL,I,IX
08200		PWDS(KP)=KL
08210		KP=KP+1
08300		RN(KL)=P0
08400		RN(KL+1)=P1
08500		RN(KL+2)=RT
08600		RN(KL+3)=P3
08700		RN(KL+4)=P4
08702		RN(KL+5)=P5
08810		IF(P0.LT.4.)GO TO 1
08820		RN(KL+6)=P6
08830		IF(P0.LT.5)GO TO 1
08832		RN(KL+7)=P7
08835		IF(P0.LT.6)GO TO 1
08840		RN(KL+8)=P8
08850	1	KL=KL+P0+3.
09000		END
09100	
09150		FUNCTION RIGHT(NA,J)
09200		COMMON /PX/SX,PN(1800),Q(6000)
09300		K=NA+J
09350	C  J IS EITHER +1 OR -1
09400	1	L=PN(K)
09500		IF(Q(L+1).NE.16)GO TO 2
09600		K=K+J
09700		GO TO 1
09800	2	RIGHT=Q(L+3)
09900		END